home *** CD-ROM | disk | FTP | other *** search
/ SGI Freeware 1999 August / SGI Freeware 1999 August.iso / dist / fw_xemacs.idb / usr / freeware / lib / xemacs-20.4 / lisp / games / hanoi.el.z / hanoi.el
Encoding:
Text File  |  1998-05-21  |  7.7 KB  |  250 lines
  1. ;;; hanoi.el --- towers of hanoi in GNUmacs
  2.  
  3. ;; Author: Damon Anton Permezel
  4. ;; Maintainer: FSF
  5. ;; Keywords: games
  6.  
  7. ; Author (a) 1985, Damon Anton Permezel
  8. ; This is in the public domain
  9. ; since he distributed it without copyright notice in 1985.
  10.  
  11. ;; This file is part of XEmacs.
  12.  
  13. ;; XEmacs is free software; you can redistribute it and/or modify it
  14. ;; under the terms of the GNU General Public License as published by
  15. ;; the Free Software Foundation; either version 2, or (at your option)
  16. ;; any later version.
  17.  
  18. ;; XEmacs is distributed in the hope that it will be useful, but
  19. ;; WITHOUT ANY WARRANTY; without even the implied warranty of
  20. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  21. ;; General Public License for more details.
  22.  
  23. ;; You should have received a copy of the GNU General Public License
  24. ;; along with XEmacs; see the file COPYING.  If not, write to the Free
  25. ;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
  26. ;; 02111-1307, USA.
  27.  
  28. ;;; Synched up with: FSF 19.34.
  29.  
  30. ;;; Commentary:
  31.  
  32. ;; Solves the Towers of Hanoi puzzle while-U-wait.
  33. ;;
  34. ;; The puzzle: Start with N rings, decreasing in sizes from bottom to
  35. ;; top, stacked around a post.  There are two other posts.  Your mission,
  36. ;; should you choose to accept it, is to shift the pile, stacked in its
  37. ;; original order, to another post.
  38. ;;
  39. ;; The challenge is to do it in the fewest possible moves.  Each move
  40. ;; shifts one ring to a different post.  But there's a rule; you can
  41. ;; only stack a ring on top of a larger one.
  42. ;;
  43. ;; The simplest nontrivial version of this puzzle is N = 3.  Solution
  44. ;; time rises as 2**N, and programs to solve it have long been considered
  45. ;; classic introductory exercises in the use of recursion.
  46. ;;
  47. ;; The puzzle is called `Towers of Hanoi' because an early popular
  48. ;; presentation wove a fanciful legend around it.  According to this
  49. ;; myth (uttered long before the Vietnam War), there is a Buddhist
  50. ;; monastery at Hanoi which contains a large room with three time-worn
  51. ;; posts in it surrounded by 21 golden discs.  Monks, acting out the
  52. ;; command of an ancient prophecy, have been moving these disks, in
  53. ;; accordance with the rules of the puzzle, once every day since the
  54. ;; monastery was founded over a thousand years ago.  They are said
  55. ;; believe that when the last move of the puzzle is completed, the
  56. ;; world will end in a clap of thunder.  Fortunately, they are nowhere
  57. ;; even close to being done...
  58.  
  59. ;;; Code:
  60.  
  61. ;;;
  62. ;;; hanoi-topos - direct cursor addressing
  63. ;;;
  64. (defun hanoi-topos (row col)
  65.   (goto-line row)
  66.   (beginning-of-line)
  67.   (forward-char col))
  68.  
  69. ;;;
  70. ;;; hanoi - user callable Towers of Hanoi
  71. ;;;
  72. ;;;###autoload
  73. (defun hanoi (nrings)
  74.   "Towers of Hanoi diversion.  Argument is number of rings."
  75.   (interactive
  76.    (list (if (null current-prefix-arg)
  77.              3
  78.        (prefix-numeric-value current-prefix-arg))))  
  79.   (if (<= nrings 0) (error "Negative number of rings"))
  80.   (let* (floor-row
  81.      fly-row
  82.      (window-height (1- (window-height (selected-window))))
  83.      (window-width (window-width (selected-window)))
  84.  
  85.      ;; This is half the spacing to use between poles.
  86.      (pole-spacing (/ window-width 6)))
  87.     (if (not (and (> window-height (1+ nrings))
  88.           (> pole-spacing nrings)))
  89.     (progn
  90.       (delete-other-windows)
  91.       (if (not (and (> (setq window-height
  92.                  (1- (window-height (selected-window))))
  93.                (1+ nrings))
  94.             (> (setq pole-spacing (/ window-width 6))
  95.                nrings)))
  96.           (error "Window is too small (need at least %dx%d)"
  97.              (* 6 (1+ nrings)) (+ 2 nrings)))))
  98.     (setq floor-row (if (> (- window-height 3) (1+ nrings))
  99.             (- window-height 3) window-height))
  100.     (let ((fly-row (- floor-row nrings 1))
  101.       ;; pole: column . fill height
  102.       (pole-1 (cons (1- pole-spacing) floor-row))
  103.       (pole-2 (cons (1- (* 3 pole-spacing)) floor-row))
  104.       (pole-3 (cons (1- (* 5 pole-spacing)) floor-row))
  105.       (rings (make-vector nrings nil)))
  106.       ;; construct the ring list
  107.       (let ((i 0))
  108.     (while (< i nrings)
  109.       ;; ring: [pole-number string empty-string]
  110.       (aset rings i (vector nil
  111.                 (make-string (+ i i 3) (+ ?0 (% i 10)))
  112.                 (make-string (+ i i 3) ?\  )))
  113.       (setq i (1+ i))))
  114.       ;;
  115.       ;; init the screen
  116.       ;;
  117.       (switch-to-buffer "*Hanoi*")
  118.       (setq buffer-read-only nil)
  119.       (buffer-disable-undo (current-buffer))
  120.       (erase-buffer)
  121.       (let ((i 0))
  122.     (while (< i floor-row)
  123.       (setq i (1+ i))
  124.       (insert-char ?\  (1- window-width))
  125.       (insert ?\n)))
  126.       (insert-char ?= (1- window-width))
  127.  
  128.       (let ((n 1))
  129.     (while (< n 6)
  130.       (hanoi-topos fly-row (1- (* n pole-spacing)))
  131.       (setq n (+ n 2))
  132.       (let ((i fly-row))
  133.         (while (< i floor-row)
  134.           (setq i (1+ i))
  135.           (next-line 1)
  136.           (insert ?\|)
  137.           (delete-char 1)
  138.           (backward-char 1)))))
  139.       ;(sit-for 0)
  140.       ;;
  141.       ;; now draw the rings in their initial positions
  142.       ;;
  143.       (let ((i 0)
  144.         ring)
  145.     (while (< i nrings)
  146.       (setq ring (aref rings (- nrings 1 i)))
  147.       (aset ring 0 (- floor-row i))
  148.       (hanoi-topos (cdr pole-1)
  149.                (- (car pole-1) (- nrings i)))
  150.       (hanoi-draw-ring ring t nil)
  151.       (setcdr pole-1 (1- (cdr pole-1)))
  152.       (setq i (1+ i))))
  153.       (setq buffer-read-only t)
  154.       (sit-for 0)
  155.       ;; Disable display of line and column numbers, for speed.
  156.       (let ((line-number-mode nil)
  157.         (column-number-mode nil))
  158.     ;; do it!
  159.     (hanoi0 (1- nrings) pole-1 pole-2 pole-3))
  160.       (goto-char (point-min))
  161.       (message "Done")
  162.       (setq buffer-read-only t)
  163.       (force-mode-line-update)
  164.       (sit-for 0))))
  165.  
  166. ;;;
  167. ;;; hanoi0 - work horse of hanoi
  168. ;;;
  169. (defun hanoi0 (n from to work)
  170.   (cond ((input-pending-p)
  171.      (signal 'quit (list "I can tell you've had enough")))
  172.     ((< n 0))
  173.     (t
  174.      (hanoi0 (1- n) from work to)
  175.      (hanoi-move-ring n from to)
  176.      (hanoi0 (1- n) work to from))))
  177.  
  178. ;;;
  179. ;;; hanoi-move-ring - move ring 'n' from 'from' to 'to'
  180. ;;;
  181. ;;;
  182. (defun hanoi-move-ring (n from to)
  183.   (let ((ring (aref rings n))        ; ring <- ring: (ring# . row)
  184.     (buffer-read-only nil))
  185.     (let ((row (aref ring 0))        ; row <- row ring is on
  186.       (col (- (car from) n 1))    ; col <- left edge of ring
  187.       (dst-col (- (car to) n 1))    ; dst-col <- dest col for left edge
  188.       (dst-row (cdr to)))        ; dst-row <- dest row for ring
  189.       (hanoi-topos row col)
  190.       (while (> row fly-row)        ; move up to the fly row
  191.     (hanoi-draw-ring ring nil t)    ; blank out ring
  192.     (previous-line 1)        ; move up a line
  193.     (hanoi-draw-ring ring t nil)    ; redraw
  194.     (sit-for 0)
  195.     (setq row (1- row)))
  196.       (setcdr from (1+ (cdr from)))    ; adjust top row
  197.       ;;
  198.       ;; fly the ring over to the right pole
  199.       ;;
  200.       (while (not (equal dst-col col))
  201.     (cond ((> dst-col col)        ; dst-col > col: right shift
  202.            (end-of-line 1)
  203.            (delete-backward-char 2)
  204.            (beginning-of-line 1)
  205.            (insert ?\  ?\  )
  206.            (sit-for 0)
  207.            (setq col (1+ (1+ col))))
  208.           ((< dst-col col)        ; dst-col < col: left shift
  209.            (beginning-of-line 1)
  210.            (delete-char 2)
  211.            (end-of-line 1)
  212.            (insert ?\  ?\  )
  213.            (sit-for 0)
  214.            (setq col (1- (1- col))))))
  215.       ;;
  216.       ;; let the ring float down
  217.       ;;
  218.       (hanoi-topos fly-row dst-col)
  219.       (while (< row dst-row)        ; move down to the dest row
  220.     (hanoi-draw-ring ring nil (> row fly-row)) ; blank out ring
  221.     (next-line 1)            ; move down a line
  222.     (hanoi-draw-ring ring t nil)    ; redraw ring
  223.     (sit-for 0)
  224.     (setq row (1+ row)))
  225.       (aset ring 0 dst-row)
  226.       (setcdr to (1- (cdr to))))))    ; adjust top row
  227.  
  228. ;;;
  229. ;;; draw-ring -    draw the ring at point, leave point unchanged
  230. ;;;
  231. ;;; Input:
  232. ;;;    ring
  233. ;;;    f1    -    flag: t -> draw, nil -> erase
  234. ;;;    f2    -    flag: t -> erasing and need to draw ?\|
  235. ;;;
  236. (defun hanoi-draw-ring (ring f1 f2)
  237.   (save-excursion
  238.     (let* ((string (if f1 (aref ring 1) (aref ring 2)))
  239.        (len (length string)))
  240.       (delete-char len)
  241.       (insert string)
  242.       (if f2
  243.       (progn
  244.         (backward-char (/ (+ len 1) 2))
  245.         (delete-char 1) (insert ?\|))))))
  246.  
  247. (provide 'hanoi)
  248.  
  249. ;;; hanoi.el ends here
  250.